home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_200 / 297_01 / prlush.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-12-30  |  27.6 KB  |  1,031 lines
  1. /* prlush.c */
  2. /* Lush resolution .
  3.  * Along with unification these are the most important routines in Prolog.
  4.  * If you want to embed Small Prolog then you won't need query_loop as such.
  5.  * See Chris Hogger's "An Introduction to Logic Programming" (Academic Press)
  6.  * if you are hungry for more explanation.
  7.  */
  8. /* Small Prolog uses a control stack , a substitution stack and a 
  9.  * "trail" to represent its run-time state.
  10.  * The control stack is the stack of "activation records".
  11.  * A clause packet is the linked list of clauses that correspond to
  12.  * a predicate. It's prolog's equivalent of a procedure.
  13.  * You enter a procedure when a goal is unified successfully with the
  14.  * head of a clause. You can enter the procedure at different clauses.
  15.  * Execution tries the clauses in the order of their occurence in the
  16.  * list.
  17.  * Each time a procedure (clause packet) is entered, a corresponding "frame"
  18.  * (or what is called "activation record" in languages like C)
  19.  * is pushed on the control stack, and a corresponding frame is pushed
  20.  * on the substitution stack(representing the parameters).
  21.  * However the situation is much more complicated than what occurs in 
  22.  * familiar languages because a procedure might have to be redone
  23.  * (with the next clause of the packet) after exit of the procedure.
  24.  * So you cant just pop the frame on successful return.
  25.  * Popping the frame only occurs on backtracking, unless you implement
  26.  * an optimisation that recognises that no more clauses could be tried.
  27.  * I have not implemented this optimisation in the current version, sorry.
  28.  
  29. *  Each frame must remember its parent: a pointer to the frame of
  30.  * the clause which contains the goal that led to the current clause.
  31.  * This is used when every goal of the clause has been successfully solved.
  32.  * This is not necessarily the previous frame because the previous frame 
  33.  * comes from the elder brother goal.
  34.  * We need to remember also the next goal to try if the current goal
  35.  * ends up being successful.
  36.  * We need to remember the last "backtrack point": this is a frame
  37.  * where there seemed to be the possibility of another solution
  38.  * for its procedure.
  39.  * We backtrack to that point when there is a failure.
  40.  * There is a global variable that does this. But this variable
  41.  * will have to be updated when we backtrack so we need to save
  42.  * the previous values of it on the stack too. To save a little
  43.  * space only some frames need to store the last backtrack point,
  44.  * These are "non-deterministic frames", frames in which there
  45.  * was a remaining candidate to the current clause.
  46.  * Sometimes substitions are created low in the substitution stack
  47.  * -before the environment of the current goal. This is why
  48.  * we use a trail to be able to unset these substitutions on backtracking.
  49.  * We have been lazy and recorded all substitutions on the 
  50.  * trail.
  51.  */
  52.     
  53.    
  54.  
  55. #include <stdio.h>
  56. #include <setjmp.h> /* added this on Dec 21 1991 */
  57. #include <assert.h>  /* added this on Dec 21 1991 */
  58. #include "prtypes.h"
  59. #include "prlush.h"
  60.  
  61.  
  62. #define NOTVARPRED "A variable can't be used as a predicate\n"
  63. #define NOPRED "Predicate not atom\n"
  64. #define STACKCONTENTS "Ancestors of current goal:\n"
  65. #define INIQUERY "Syntax error ini initial query"
  66. #define STRINGQUERY "Syntax error ini query passed as string"
  67.  
  68. #if TRACE_CAPABILITY
  69. /*  values of where in tracing */
  70. #define G_BTK          'B' /* goto bactrack */
  71. #define G_AGA        'P' /* goto AGAIN */
  72. #define KEEP_GOING    'K'
  73.  
  74. #define TRACE(X) if(Trace_flag > 0){\
  75.          if(X == 0)return ABNORMAL_LUSH_RETURN;\
  76.         switch(where){case G_AGA:goto AGAIN;case G_BTK:goto BACKTRACK;}}
  77.          
  78. #define CAN_SKIP 1
  79. #define CANT_SKIP 0
  80. #else
  81. #define TRACE(X)
  82. #endif
  83.  
  84. /* Although the Trace_flag can be set by a builtin
  85.    actual tracing can be suspended while stepping over a call .
  86.   The following two variables are used for this purpose.
  87.  */
  88. static int Copy_tracing_now;
  89.  
  90. #ifdef HUNTBUGS
  91.     extern int Bug_hunt_flag;
  92. #endif
  93.  
  94.  
  95. extern subst_ptr_t DerefSubst; /* enviroment of last dereferenced 
  96.                 object  */
  97. extern subst_ptr_t my_Subst_alloc();
  98. extern node_ptr_t DerefNode; /* skeleton of last dereferenced object */
  99. extern node_ptr_t NilNodeptr; /* node corresponding to empty list */
  100. extern atom_ptr_t Nil;        /* object  of empty list */
  101. extern clause_ptr_t Bltn_pseudo_clause;
  102. extern dyn_ptr_t HighDyn_ptr,Dyn_mem, Dyn_ptr, my_Dyn_alloc(); /* for control stack */
  103. extern subst_ptr_t Subst_mem, Subst_ptr; /* for substitution stack */
  104. extern node_ptr_t **Trail_mem, **Trail_ptr;
  105. extern FILE * Curr_outfile;
  106.  
  107.  
  108. void ini_lush(), reset_zones();
  109.  
  110. clause_ptr_t Curr_clause; /* current clause containing Goals */
  111. clause_ptr_t Candidate;   /*Used when we look for a clause whose
  112.              head might match goal */
  113. dyn_ptr_t QueryCframe;   /* Control frame of Query */
  114. dyn_ptr_t LastCframe; /* most recent Cframe */
  115. dyn_ptr_t LastBack; /* points to cframe of most recent backtrack point */
  116. dyn_ptr_t Parent;   /* parent Cframe of current goal */
  117. dyn_ptr_t BackFrame; /* parent frame in case of reverse tracing */
  118. node_ptr_t Goals; /* what remains of current goals of the clause.
  119.             The head of the list is the goal to satisfy first.
  120.             Note that there will be (in general) other goals to 
  121.             satisfy on completion of solution of Goals
  122.          */
  123. node_ptr_t Query; /* the initial query */
  124. node_ptr_t Arguments;/* arguments of current goal (points to a list) */
  125. subst_ptr_t Subst_goals, /* substituion env of Goals         */
  126. SubstGoal, /* can be different to Subst_goals if there is a "call" */
  127. OldSubstTop; /* for backtracking */
  128. atom_ptr_t Predicate; /* predicate of current goal     */
  129. node_ptr_t **OldTrailTop;
  130. int ErrorGlobal; /* used to communicate the fact there was an error */
  131. int Deterministic_flag; /*used to minimise "more?" questions after a solution */
  132. int ReverseTraceMode = 0; /* if set to 1 means you can trace backwards 
  133.               but this is greedy on control stack space 
  134.               because all frames are like the non-deterministic
  135.               frames.
  136.             */
  137. integer Nunifications = 0; /* just for statistics */
  138.  
  139. /******************************/
  140. /* Dec 21 1991 new variables: */
  141. /******************************/
  142.  
  143. node_ptr_t ND_builtin_next_nodeptr;/* This is for 
  144.     non deterministic builtins. When this variable is NULL it
  145.     is the first call of the predicate. Otherwise it is the nodeptr
  146.      that guides the non deterministic builtin.
  147.     */
  148. jmp_buf Bltin_env; /* see do_builtin() */
  149. jmp_buf Query_jenv; /* see query_loop() */
  150. int QJusable = 0; /* Determines if we can longjump to Query_jenv */
  151.  
  152. #if TRACE_CAPABILITY
  153. extern int Trace_flag; /* sets trace mode */
  154. extern int Tracing_now; /* sets trace mode */
  155. dyn_ptr_t Skip_above;
  156. int Unleash_flag = 0;
  157. #endif
  158.  
  159.  
  160. /*******************************************************************
  161.         read_goals()
  162.  Called by query_loop.
  163.  Updates Goals, Nvars and Query. 
  164.  *******************************************************************/
  165. read_goals(ifp)
  166. FILE *ifp;
  167. {
  168.     extern node_ptr_t read_list(), get_node();
  169.     extern FILE * Curr_infile;
  170.  
  171.     node_ptr_t head;
  172.     FILE * save_cif;
  173.  
  174.     ENTER("read_goals");
  175.     save_cif = Curr_infile;
  176.     Curr_infile = ifp;
  177.     Goals = read_list(PERMANENT);
  178.     if(Goals == NULL)return(0);
  179.     copy_varnames();
  180.     head = NODEPTR_HEAD(Goals);
  181.  
  182.     if(NODEPTR_TYPE(head) == ATOM)
  183.     {
  184.         pair_ptr_t pairptr, get_pair();
  185.  
  186.         pairptr = get_pair(DYNAMIC);
  187.         NODEPTR_TYPE(PAIRPTR_HEAD(pairptr)) = PAIR;
  188.         NODEPTR_PAIR(PAIRPTR_HEAD(pairptr)) = NODEPTR_PAIR(Goals);
  189.         NODEPTR_TYPE(PAIRPTR_TAIL(pairptr)) = ATOM;
  190.         NODEPTR_ATOM(PAIRPTR_TAIL(pairptr)) = Nil;
  191.         Goals = get_node(DYNAMIC);
  192.         NODEPTR_TYPE(Goals) = PAIR;
  193.         NODEPTR_PAIR(Goals) = pairptr;
  194.     }
  195.  
  196.     Query = Goals;
  197.     Curr_infile = save_cif;
  198.  
  199.     return(1);
  200. }
  201.  
  202.  
  203. /******************************************************************************
  204.             initial_query
  205.  This executes the query from a file . It is silent if the file does not exist.
  206.  ******************************************************************************/
  207. initial_query(filename)
  208. char *filename;
  209. {
  210.     FILE *ifp;
  211.     
  212.     ENTER("initial_query");
  213.     if((ifp = fopen(filename, "r")) == NULL)
  214.           return(1);        /* silent */
  215.     reset_zones();
  216.     Skip_above = HighDyn_ptr;
  217.     if(!read_goals(ifp))
  218.     {
  219.         fatal(INIQUERY);
  220.     }
  221.     fclose(ifp);
  222.     ini_lush();
  223.     return(lush(TRUE) != FINAL_LUSH_RETURN );
  224.  
  225. }
  226.  
  227. #ifdef PROLOG_IS_CALLED_FROM_OTHER_PROGRAM
  228. /******************************************************************************
  229.         execute_query()
  230.  This could be used to execute a query passed as a string.
  231.  This means you could embed Small Prolog in another program.
  232.  Not currently used, but why not modify main() to make use of it?
  233.  ******************************************************************************/
  234.  
  235. execute_query(s)
  236. char *s;
  237. {
  238. extern int String_input_flag;
  239. extern char *Curr_string_input;
  240.  
  241.     ENTER("execute_query");
  242.     String_input_flag = 1;
  243.     Curr_string_input = s;
  244.     reset_zones();
  245.     Skip_above = HighDyn_ptr;
  246.  
  247.     if(!read_goals(stdin/* ignored */))
  248.     {
  249.         fatal(STRINGQUERY);
  250.     }
  251.     String_input_flag = 0;
  252.     ini_lush();
  253.     return(lush(1) != FINAL_LUSH_RETURN);
  254. }
  255. #endif
  256.  
  257.  
  258. /*******************************************************************
  259.         query_loop()
  260.  Called by main().
  261.  This is the interactive question-answer loop driver.
  262.  *******************************************************************/
  263. query_loop()
  264. {
  265.     int first_time = TRUE;/* have not backtracked yet */
  266.     int stop_state;
  267.     varindx nvar_query;
  268.     extern varindx Nvars;
  269.  
  270.     ENTER("query_loop");
  271.     do     {
  272.         setjmp(Query_jenv); 
  273.         QJusable = 1; /* indicates we can longjump to Query_jenv */
  274.         reset_zones();
  275.         Skip_above = HighDyn_ptr;
  276.         prompt_user();
  277.  
  278.         if(!read_goals(stdin))continue;/* updates Goals, Nvars */
  279.         tty_getc();/* read the carriage return */
  280.         nvar_query = Nvars;
  281.         ini_lush(); /* Updates Curr_clause... */
  282.  
  283.         do{
  284.             stop_state = lush(first_time);
  285.  
  286.             switch(stop_state)
  287.             {
  288.             case SUCCESS_LUSH_RETURN:
  289.                 first_time = FALSE;
  290.                 pr_solution(nvar_query, BASE_SUBST);
  291.                 if(LastBack < QueryCframe)
  292.                     Deterministic_flag = 1;
  293.                 if(!Deterministic_flag && 
  294.                     more_y_n())/*  want another solution? */
  295.                 {/* answers yes */
  296.                     break;
  297.                 }
  298.                 else
  299.                 {
  300.                     stop_state = FAIL_LUSH_RETURN;
  301.                 }
  302.                 first_time = TRUE;
  303.                 break;
  304.  
  305.             case FINAL_LUSH_RETURN:
  306.                 tty_pr_string("Bye ...\n");
  307.                 return;
  308.  
  309.             case ABNORMAL_LUSH_RETURN:
  310.                 first_time = TRUE;
  311.                 stop_state = FAIL_LUSH_RETURN;
  312.                 break;/* just a way of avoiding a goto */
  313.  
  314.             case FAIL_LUSH_RETURN:
  315.                 tty_pr_string("No\n");
  316.                 first_time = TRUE;
  317.                 break;
  318.  
  319.             default:
  320.                 INTERNAL_ERROR("lush return");
  321.             }
  322.         }while(stop_state != FAIL_LUSH_RETURN);
  323.     }while(1);
  324. }
  325.  
  326. /*******************************************************************
  327.             ini_lush()
  328.   Sets up the global variables, stack etc...
  329.  
  330.   Note that a pseudo-clause is created whose goals represent
  331.   the query. Gasp, it's headless!
  332.  *******************************************************************/
  333. void ini_lush()
  334. {
  335.     clause_ptr_t get_clause();
  336.     extern varindx Nvars;
  337.  
  338.     ENTER("ini_lush");
  339.     Deterministic_flag = 1;
  340.     QueryCframe = Dyn_ptr;
  341.     Parent = QueryCframe;
  342.     OldSubstTop =  BASE_SUBST;
  343.     OldTrailTop =  Trail_ptr;
  344.     LastBack = NULL;
  345.     my_Subst_alloc((unsigned int)(Nvars * sizeof(struct subst)));
  346.     Curr_clause = get_clause(PERMANENT); /* could be DYNAMIC !! */
  347.  
  348.     CLAUSEPTR_GOALS(Curr_clause) = Goals;
  349.     CLAUSEPTR_HEAD(Curr_clause) = NilNodeptr; /* Who said one head
  350.                         is better than none ? */
  351.     CLAUSEPTR_NEXT(Curr_clause) = NULL;
  352.     /* Currclause is artificial */
  353.     LastCframe = Dyn_ptr;
  354.     FRAME_PARENT(LastCframe) = Parent;
  355.     FRAME_SUBST(LastCframe) = OldSubstTop;
  356.     FRAME_GOALS(LastCframe) = Goals;
  357. #ifdef DFRAMES_HAVE_TYPE_FIELD 
  358.     FRAME_TYPE(LastCframe) = D_FRAME;
  359. #endif
  360.     my_Dyn_alloc(SIZE_DCFRAME);
  361. }
  362.  
  363. /*******************************************************************
  364.             reset_zones()
  365.  Clean things up .
  366.  *******************************************************************/
  367. void reset_zones()
  368. {
  369.     ENTER("reset_zones");
  370.     Dyn_ptr = BASE_CSTACK;
  371.     Subst_ptr = BASE_SUBST;
  372.     reset_trail(BASE_TRAIL);
  373. }
  374.  
  375. /*******************************************************************
  376.             do_builtin()
  377.  Call a builtin. Notice that it uses global variables to get 
  378.  at the arguments of the builtin.
  379.  *******************************************************************/
  380. do_builtin(bltn)
  381. intfun bltn; /* a function */
  382. {
  383.     int ret;
  384.  
  385.     ENTER("do_builtin");
  386.  
  387.     if(setjmp(Bltin_env))
  388.        return(0);/* fail */
  389.  
  390.     ret = (*bltn)();
  391. /*    BUGHUNT(ATOMPTR_NAME(Predicate));  a good place
  392.     to do a checksum when looking for bugs; See Robert Ward's book
  393.     "Debugging C" 
  394.  */
  395.     return(ret);
  396. }
  397.  
  398.  
  399. /*******************************************************************
  400.             determine_predicate()
  401. Returns current predicate by dereferencing goal expression.
  402. Updates Arguments, SubstGoal and others.
  403.  This is more complicated than might appear at first sight because
  404.   there are several cases involving goals that are variables.
  405.  *******************************************************************/
  406. atom_ptr_t determine_predicate()
  407. {
  408.     node_ptr_t goal, headnode;
  409.  
  410.     ENTER("determine_predicate");
  411.     goal = NODEPTR_HEAD(Goals);
  412.  
  413.     if(!dereference(goal, Subst_goals))
  414.     {
  415.         errmsg(NOTVARPRED);
  416.         ErrorGlobal = ABORT;
  417.         return(NULL);
  418.     }
  419.  
  420.     switch(NODEPTR_TYPE(DerefNode))
  421.     {
  422.     case ATOM:
  423.         Arguments =  NilNodeptr;
  424.         SubstGoal = DerefSubst;
  425.         return(NODEPTR_ATOM(DerefNode));
  426.     case PAIR:
  427.         SubstGoal = DerefSubst;
  428.         headnode = NODEPTR_HEAD(DerefNode);
  429.         Arguments = NODEPTR_TAIL(DerefNode);
  430.  
  431.         if(!dereference(headnode, SubstGoal))
  432.         {
  433.             errmsg(NOTVARPRED);
  434.             ErrorGlobal = ABORT;
  435.             return(NULL);
  436.         }
  437.         headnode = DerefNode;
  438.  
  439.         if(NODEPTR_TYPE(headnode) != ATOM)
  440.         {
  441.             errmsg(NOPRED);
  442.             ErrorGlobal = ABORT;
  443.             return(NULL);
  444.         }
  445.         return(NODEPTR_ATOM(headnode));
  446.     default:
  447.         ErrorGlobal = ABORT;
  448.         return(NULL);
  449.     }
  450. }
  451.  
  452. /****************************************************************************
  453.             do_cut()
  454. Implements the infamous cut. This is called by Pcut in prbuiltin.c
  455.  As an excercise try reclaiming space on the control stack.
  456.  ***************************************************************************/
  457. void do_cut()
  458. {
  459.     ENTER("do_cut");
  460.  
  461.     if (LastBack == NULL)return;
  462.     else
  463.         while (LastBack >= QueryCframe && LastBack >= Parent)
  464.             LastBack = FRAME_BACKTRACK(LastBack);
  465. }
  466.  
  467. /****************************************************************************
  468.             dump_ancestors()
  469.  Lets you look at the ancestors of the call when something has gone wrong.
  470.  Should not be called dump_ancestors because it only shows the ancestors.
  471.  ***************************************************************************/
  472. void dump_ancestors(cframe)
  473. dyn_ptr_t cframe;
  474. {
  475.     int i;
  476.     node_ptr_t goals;
  477.  
  478.     Curr_outfile = stdout;
  479.     tty_pr_string(STACKCONTENTS);
  480.     tty_pr_string("\n");
  481.     i = 1;
  482.  
  483.     if (cframe == LastCframe)
  484.        {
  485.        i++;
  486.            out_node(Goals, Subst_goals);
  487.        tty_pr_string("\n");
  488.        }
  489.     
  490.     while(cframe != QueryCframe)
  491.     {
  492.         goals = FRAME_GOALS( cframe );
  493.         out_node(goals, FRAME_SUBST( cframe ));
  494.         cframe = FRAME_PARENT( cframe );
  495.         tty_pr_string("\n");
  496.  
  497.         if(i++ == MAX_LINES)
  498.         {
  499.                i = 1;
  500.             if (!more_y_n())
  501.                 break;
  502.         }
  503.     }
  504.  
  505. }
  506.  
  507. #if TRACE_CAPABILITY
  508.  
  509. /************************************************************************/
  510. /*         Tracing routines                     */
  511. /************************************************************************/
  512. /*************************************************************************
  513.             function trace_pause()
  514.  *************************************************************************/
  515.  
  516. int trace_pause(pwhere, skipp)
  517. int *pwhere, skipp;
  518. {
  519.     char c;
  520.  
  521.     *pwhere = KEEP_GOING; /* default */
  522.  
  523.     if(Unleash_flag){
  524.       tty_pr_string("\n");
  525.       return(1);
  526.       }
  527.  
  528.     c = tty_getche();
  529.     tty_pr_string("\n");
  530.     switch(c)
  531.     {
  532.     case '\n':
  533.     case '\r':
  534.         Skip_above = HighDyn_ptr;
  535.         break;
  536.  
  537.     case 'n':
  538.         Trace_flag = 0; /* stop tracing, continue execution */
  539.         Tracing_now = 0;
  540.         break;
  541.  
  542.     case 's':
  543.         if(skipp == CANT_SKIP)
  544.             return 1;
  545.         Skip_above = Parent;
  546.         Copy_tracing_now = Tracing_now;
  547.         Tracing_now = 0;
  548.         break;
  549.  
  550.     case '2':
  551.         Trace_flag = 2;
  552.         break;
  553.  
  554.     case '1':
  555.         Trace_flag = 1;
  556.         break;
  557.  
  558.     case 'a':
  559.         Trace_flag = 0;
  560.         Tracing_now = 0;
  561.         return 0;
  562.  
  563.     case 'P':
  564.         BackFrame = Parent;
  565.         if(   (BackFrame < BASE_CSTACK)
  566.            || (FRAME_TYPE(BackFrame) == D_FRAME)
  567.            || !ReverseTraceMode
  568.           )
  569.           {
  570.             tty_pr_string("Cannot reverse step just here\n");
  571.           tty_pr_string("Please retype your command:");
  572.           return trace_pause();
  573.             }
  574.         *pwhere = G_AGA;
  575.         break;
  576.  
  577.     case 'B':
  578.         *pwhere = G_BTK;
  579.                 break;
  580.  
  581.     case 'U':
  582.         Unleash_flag = 1;
  583.         break;
  584.     default:
  585.         tty_pr_string("type:\n");
  586.         tty_pr_string("Enter to see next step\n");
  587.         tty_pr_string("2 to increase the trace details\n");
  588.         tty_pr_string("1 to return to normal trace details\n");
  589.         tty_pr_string("a to abort trace and execution\n");
  590.         tty_pr_string("n to abort trace but continue execution\n");
  591.         tty_pr_string("s to step over current goal \n");
  592.         tty_pr_string("P to come back to parent goal\n");
  593.         tty_pr_string("B to backtrack\n");
  594.         tty_pr_string("U to trace without prompt\n");
  595.         tty_pr_string("please retype your command:");
  596.         return trace_pause();
  597.     }
  598. return 1;
  599. }
  600.  
  601.  
  602. static int tr_immediate_exit(pwhere)
  603. int *pwhere;
  604. {
  605. int res = 1;
  606.  
  607.      if(!Tracing_now && Skip_above >= Parent)
  608.          Tracing_now= Copy_tracing_now;
  609.      if(Tracing_now){
  610.     pr_string(" Exit ");
  611.     out_node(NODEPTR_HEAD(Goals),SubstGoal);
  612.     res = trace_pause(pwhere,CANT_SKIP);
  613.     }
  614.  
  615. return (res);
  616. }
  617.  
  618. static  tr_exit(pwhere)
  619. int *pwhere;
  620. {
  621.  
  622. int res = 1;
  623.  
  624.      if(!Tracing_now && Skip_above >= Parent)
  625.          Tracing_now = Copy_tracing_now;
  626.      if(Tracing_now){
  627.     pr_string("...exit ");
  628.     out_node(NODEPTR_HEAD(Goals),FRAME_SUBST(Parent));
  629.     res = trace_pause(pwhere,CANT_SKIP);
  630.     }
  631. return(res);
  632. }
  633.  
  634. static int tr_redo(pwhere)
  635. int *pwhere;
  636. {
  637.  int res = 1;
  638.  if(!Tracing_now && Skip_above > Parent)
  639.     Tracing_now = Copy_tracing_now;
  640.  if(Tracing_now){
  641.    pr_string(" Redo ");
  642.    out_node(NODEPTR_HEAD(Goals),SubstGoal);
  643.    res = trace_pause(pwhere,CAN_SKIP);
  644.    }
  645. return(res);
  646. }
  647.  
  648. static int tr_call(pwhere)
  649. int *pwhere;
  650. {
  651. int res = 1;
  652.     if(Tracing_now){
  653.        pr_string(" Call ");
  654.        out_node(NODEPTR_HEAD(Goals), SubstGoal);
  655.        res = trace_pause(pwhere,CAN_SKIP);
  656.        }
  657. return(res);
  658. }
  659.  
  660. static int tr_again(pwhere)
  661. int *pwhere;
  662. {
  663. int res = 1;
  664.     if(Tracing_now){
  665.        pr_string(" Again ");
  666.        out_node(NODEPTR_HEAD(Goals),SubstGoal);
  667.        res = trace_pause(pwhere,CAN_SKIP);
  668.        }
  669. return(res);
  670. }
  671.  
  672. static void tr_fail()
  673. {
  674.  if(!Tracing_now)
  675.    {
  676.   while( Parent > LastBack && Parent > QueryCframe)
  677.       {
  678.     Goals = FRAME_GOALS(Parent);
  679.     Parent = FRAME_PARENT(Parent);
  680.     if(Skip_above >= Parent){
  681.        Tracing_now = Copy_tracing_now;
  682.        SubstGoal = FRAME_SUBST(Parent);
  683.            break;    
  684.       }
  685.        }/* while */
  686.      }/* if */
  687. if(!Tracing_now && (Parent <= Skip_above))
  688.    Tracing_now = Copy_tracing_now;
  689. if(Tracing_now)
  690.   {
  691.   if( ! IS_NIL(Goals)){
  692.      pr_string(" Fail ");
  693.      out_node(NODEPTR_HEAD(Goals),SubstGoal);
  694.      pr_string("\n");
  695.      }
  696.  
  697. /* print fail of Parent goals at this point */
  698.    while( Parent >  LastBack  && Parent > QueryCframe)
  699.     {
  700.     Goals = FRAME_GOALS(Parent);
  701.     Parent = FRAME_PARENT(Parent);
  702.     if( ! IS_NIL(Goals)){
  703.          pr_string(" Fail ");
  704.          out_node(NODEPTR_HEAD(Goals),FRAME_SUBST(Parent));
  705.          pr_string("\n");
  706.         }
  707.     }
  708.    }
  709. }
  710.  
  711.  
  712. /******************************************************************************
  713.             function trace_clause()
  714.  ******************************************************************************/
  715. void trace_clause(clauseptr)
  716. clause_ptr_t clauseptr;
  717. {
  718. pr_string("Trying rule ");
  719. pr_clause(clauseptr);
  720. }
  721.  
  722. #endif /* #if TRACE_CAPABILITY */
  723.  
  724. /*******************************************************************
  725.             lush()
  726.  Lush resolution algorithm.
  727.  This routine tries to solve the query and sets the stacks aworking.
  728.  Probably the most important routine.
  729.  Warning: 
  730.  If you add lots of features this becomes a big function,
  731.  you may have to set a switch in your compiler to handle the size 
  732.  of the function or it will runout of space.
  733.  Microsoft and Zortech and Mark Williams have this.
  734.  Turbo C seems not to need a special option .
  735.  *******************************************************************/
  736.  
  737. int lush(first_time)
  738. int first_time;
  739. {
  740.     int retval;
  741.     int where;
  742.  
  743.     ENTER("lush");
  744.     Unleash_flag = 0;
  745.     if(first_time != TRUE)
  746.         goto BACKTRACK; /* e.g. if you want to see a 2nd solution */
  747. SELECT_GOAL:
  748.     if(IS_FACT(Curr_clause)) /* no goals - came to leaf of proof tree */
  749.     {
  750.         Goals = FRAME_GOALS(LastCframe);
  751.  
  752.         TRACE(tr_immediate_exit(&where));
  753.         Goals = NODEPTR_TAIL(Goals);
  754.         while(Parent != QueryCframe && IS_NIL(Goals))
  755.         {
  756.             Goals = FRAME_GOALS(Parent);
  757.             Parent = FRAME_PARENT(Parent);
  758.             TRACE(tr_exit(&where));
  759.             Goals = NODEPTR_TAIL(Goals);
  760.         }
  761.         Subst_goals = FRAME_SUBST(Parent);
  762.         if(IS_NIL(Goals))
  763.         {
  764.             return(SUCCESS_LUSH_RETURN);
  765.         }
  766.     }
  767.     else /* the clause just entered has conditions, euh, goals */
  768.     {
  769.         Goals = CLAUSEPTR_GOALS(Curr_clause);
  770.         Parent = LastCframe; 
  771.         Subst_goals = OldSubstTop;
  772.     }
  773.       /* Now you've  got the goal (via Goals)
  774.       determine what the predicate is : */
  775.     Predicate = determine_predicate();/* argument list updated here */
  776.  
  777.     TRACE(tr_call(&where));
  778.  
  779.         ND_builtin_next_nodeptr = NULL;
  780.  
  781.     if(Predicate == NULL)
  782.     {
  783.         retval = ErrorGlobal;
  784.         goto BUILTIN_ACTION;
  785.     }
  786.  
  787.     if(!IS_BUILTIN(Predicate))
  788.     {
  789.         Candidate = ATOMPTR_CLAUSE(Predicate);
  790.         /* - this was the FIRST clause */
  791. #ifdef HUNTBUGS
  792.         if(Candidate!=NULL && !check_object(Candidate))
  793.           {
  794.         Curr_outfile = stdout;
  795.         pr_string(Predicate->name);
  796.         pr_string(" is the predicate \n****************************************\n");
  797.         fatal("error1 in code");
  798.           }
  799. #endif
  800. #if TRACE_CAPABILITY
  801.         if(Trace_flag > 0 && Candidate == NULL)
  802.         {
  803.             pr_string(" Undefined ");
  804.             pr_string(Predicate->name);
  805.             pr_string("\n");
  806.         }
  807.  
  808.     }
  809. #endif
  810. SELECT_CLAUSE: /* we can come here from BACTRACK and Candidate can be 
  811.                   set in the backtrack section too */
  812.     if(IS_BUILTIN(Predicate))
  813.     {
  814. /*        OldSubstTop = Subst_ptr;
  815.         OldTrailTop = Trail_ptr;
  816.         Let the builtin do this if necessary
  817.  */
  818.         retval = do_builtin(ATOMPTR_BUILTIN(Predicate));
  819. BUILTIN_ACTION:
  820.         switch( retval)
  821.         {
  822.         case FALSE:
  823.             goto BACKTRACK;
  824.  
  825.         case TRUE:
  826.             Curr_clause = Bltn_pseudo_clause;
  827.             LastCframe = Dyn_ptr; /* top of stack */
  828.             goto DFRAME;
  829.  
  830.         case ABORT:
  831.             reset_zones();
  832.             return(ABNORMAL_LUSH_RETURN);
  833.  
  834.         case CRASH:
  835.             dump_ancestors( LastCframe );
  836.             reset_zones();
  837.             return(ABNORMAL_LUSH_RETURN);
  838.  
  839.         case QUIT:
  840.             return(FINAL_LUSH_RETURN);
  841.  
  842.         case ND_SUCCESS:
  843.             Curr_clause = Bltn_pseudo_clause;
  844.             LastCframe = Dyn_ptr;
  845.  
  846.         my_Dyn_alloc(SIZE_NDCFRAME);
  847.  
  848.         Deterministic_flag = 0; /* maybe there is a choice point */
  849.         FRAME_PARENT(LastCframe) = Parent;
  850.         FRAME_SUBST(LastCframe) = OldSubstTop;
  851.         FRAME_GOALS(LastCframe) = Goals;
  852.         FRAME_ND_BLTIN_NEXT(LastCframe) = ND_builtin_next_nodeptr;
  853.         /* It is the builtin's responsability to update 
  854.         ND_builtin_next_nodeptr
  855.         */
  856.         FRAME_BACKTRACK(LastCframe) = LastBack;
  857.         FRAME_TRAIL(LastCframe) = OldTrailTop;
  858.         FRAME_TYPE(LastCframe) = ND_BUILTIN;
  859.  
  860.         LastBack = LastCframe;
  861.         goto SELECT_GOAL;
  862.         }
  863.     }
  864.     else /* It's not builtin so look amongst candidate clauses for
  865.         the one whose head will unify with the goal.
  866.         */
  867.     {
  868.         while (Candidate != NULL)
  869.         {
  870. #if TRACE_CAPABILITY
  871.         if(Trace_flag >= 2 && Tracing_now)
  872.            trace_clause(Candidate);
  873. #endif
  874.             OldSubstTop = Subst_ptr; /* save for backtrack */
  875.             OldTrailTop = Trail_ptr; /* ditto         */
  876.             my_Subst_alloc((unsigned int)
  877.                     CLAUSEPTR_NVARS(Candidate));
  878.  
  879.             if(!unify(NODEPTR_TAIL(CLAUSEPTR_HEAD(Candidate)),
  880.                 (subst_ptr_t)OldSubstTop,
  881.                 Arguments, (subst_ptr_t)SubstGoal))
  882.             {/* shallow backtrack, reset substitution and
  883.               try next clause
  884.              */
  885.                 reset_trail(OldTrailTop);
  886.                 Subst_ptr = OldSubstTop;
  887.                 Candidate = CLAUSEPTR_NEXT(Candidate);
  888.             }
  889.             else
  890.             {/* successful unification */
  891.                 Nunifications++; /* statistics only */
  892.                 Curr_clause = Candidate;
  893.                 goto CFRAME_CREATION;
  894.             }
  895.         }/* end while */
  896.         goto BACKTRACK; /* no candidate found */
  897.     }/* end it's not builtin */
  898. CFRAME_CREATION:
  899.     LastCframe = Dyn_ptr;
  900.     if(CLAUSEPTR_NEXT(Candidate) == NULL 
  901. #if TRACE_CAPABILITY
  902.        && !ReverseTraceMode
  903. #endif
  904.        )/* it's not a backtrack point.
  905.         Mild bug: This ignores possible 
  906.         assertz(Predicate(... calls in the clause 
  907.         To fix this bug I guess I would need a flag.
  908.          */
  909.     {/* deterministic frame */
  910. DFRAME:
  911.         my_Dyn_alloc(SIZE_DCFRAME);
  912.         FRAME_PARENT(LastCframe) = Parent;
  913.         FRAME_SUBST(LastCframe) = OldSubstTop;
  914.         FRAME_GOALS(LastCframe) = Goals;
  915. #ifdef DFRAMES_HAVE_TYPE_FIELD 
  916.         FRAME_TYPE(LastCframe) = D_FRAME;
  917. #endif
  918.  
  919.     }
  920.     else
  921.     { /* non deterministic frame */
  922.         my_Dyn_alloc(SIZE_NDCFRAME);
  923.         Deterministic_flag = 0; /* maybe there is a choice point */
  924.         FRAME_PARENT(LastCframe) = Parent;
  925.         FRAME_SUBST(LastCframe) = OldSubstTop;
  926.         FRAME_GOALS(LastCframe) = Goals;
  927.         FRAME_CLAUSE(LastCframe) = Curr_clause;
  928.         FRAME_BACKTRACK(LastCframe) = LastBack;
  929.         FRAME_TRAIL(LastCframe) = OldTrailTop;
  930.         FRAME_TYPE(LastCframe) = ND_CLAUSE;
  931.         LastBack = LastCframe;
  932.     }
  933.     goto SELECT_GOAL;
  934.  
  935. BACKTRACK:
  936.  
  937. #if TRACE_CAPABILITY 
  938.     
  939.     if(Trace_flag > 0)
  940.     {
  941.     tr_fail();
  942.     }
  943. #endif
  944.     if(LastBack < BASE_CSTACK)
  945.     {
  946.         return(FAIL_LUSH_RETURN);
  947.     }
  948.     Parent = FRAME_PARENT(LastBack);
  949.     Subst_goals = FRAME_SUBST(Parent);
  950.     Goals = FRAME_GOALS(LastBack);
  951.     Predicate = determine_predicate();
  952.     Dyn_ptr = LastBack;
  953.     Subst_ptr = FRAME_SUBST(LastBack);
  954.     OldTrailTop =  FRAME_TRAIL(LastBack);
  955.     reset_trail(OldTrailTop);
  956.     if(FRAME_TYPE(LastBack) == ND_CLAUSE)
  957.       {
  958.        Candidate = FRAME_CLAUSE(LastBack);
  959.       Candidate = CLAUSEPTR_NEXT(Candidate);
  960.       }
  961.     else
  962.        {
  963.        assert(FRAME_TYPE(LastBack) == ND_BUILTIN);
  964.        ND_builtin_next_nodeptr = FRAME_ND_BLTIN_NEXT(LastBack);
  965.        }
  966.     LastBack =  FRAME_BACKTRACK(LastBack);
  967.     TRACE(tr_redo(&where));
  968. #ifdef HUNTBUGS
  969.         if(Candidate!=NULL && !check_object(Candidate))
  970.           {
  971.            dump_ancestors( LastCframe );
  972.           fatal("error2 in code");
  973.           }
  974. #endif
  975.     goto SELECT_CLAUSE;
  976. #if TRACE_CAPABILITY
  977. /* 
  978.  25/12/91
  979.  This is for debugging only: 
  980.  When tracing you may have gone too far, so you might want
  981.  to step back to the parent by answering 'P' during trace.
  982.   In that case this is where execution goes to. 
  983.   This is different from backtracking because the latter tries 
  984.   the next clause.
  985.  */
  986. AGAIN:
  987.     assert(ReverseTraceMode);
  988.     Parent = FRAME_PARENT(BackFrame);
  989.     Subst_goals = FRAME_SUBST(Parent);
  990.     Goals = FRAME_GOALS(BackFrame);
  991.     Predicate = determine_predicate();
  992.     Dyn_ptr = BackFrame;
  993.     Subst_ptr = FRAME_SUBST(BackFrame);
  994.     OldTrailTop =  FRAME_TRAIL(BackFrame);
  995.      reset_trail(OldTrailTop); 
  996.  
  997.     if(FRAME_TYPE(BackFrame) == ND_CLAUSE)
  998.       {
  999.        Candidate = FRAME_CLAUSE(BackFrame);
  1000.     /* Candidate = CLAUSEPTR_NEXT(Candidate); */
  1001.       }
  1002.     else
  1003.     if(FRAME_TYPE(BackFrame) == ND_BUILTIN)
  1004.        {
  1005.        ND_builtin_next_nodeptr = FRAME_ND_BLTIN_NEXT(BackFrame);
  1006.        }
  1007.         LastBack = FRAME_BACKTRACK(BackFrame);
  1008.     TRACE(tr_again(&where));
  1009.     goto SELECT_CLAUSE;
  1010. #endif
  1011. }
  1012.  
  1013. /* new functions 12/21/91 */
  1014.  
  1015.  
  1016. /******************************************************************************
  1017.         function abandon_query()
  1018.  noone uses this!!
  1019.  ******************************************************************************/
  1020. void abandon_query()
  1021. {
  1022. if(QJusable)longjmp(Query_jenv, 0);
  1023. else
  1024.   {
  1025.   exit_term();
  1026.   exit(1);
  1027.   }
  1028. }
  1029.  
  1030. /* end of file */
  1031.